home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / pc_pad.arc / PC-PAD.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-07-29  |  8.5 KB  |  139 lines
  1. 20  SCREEN 0,0,0:WIDTH 80:CLS:KEY OFF:LOCATE 5,1:Q$=SPACE$(20):PRINT Q$;"          PC\PAD  (ver. 1.3)":PRINT Q$;"an editor/spreadsheet/printing program":PRINT:PRINT:PRINT Q$;"     If you are using this program"
  2. 70  PRINT Q$;"         and find it of value,":PRINT Q$;"   a $20 contribution is suggested.":PRINT:PRINT Q$;"               (c) 1983":PRINT Q$;"             P. Fraundorf":PRINT Q$;"            P.O. Box 11394"
  3. 130  PRINT Q$;"          St. Louis MO 63105":PRINT:PRINT Q$;"    You are encouraged to copy and":PRINT Q$;"    share this program with others.":LOCATE 24,1:PRINT"any key to continue...";
  4. 180  Q$=INKEY$:IF Q$="" THEN 180
  5. 190  DEFINT I-N:LMX=400:HCW=8:CC$="\" :DIM A$(LMX+1),M$(50),CSUM(16),RSUM(25):IMX=LMX-22:JMX=IMX-20:LCW=2*HCW:LCM=LCW-1:DEF FNV(I,J)=VAL(MID$(A$(I),LCW*J+1,LCW)):DEF SEG=0:IF (PEEK(1040) AND 48)=48 THEN LD=13 ELSE LD=7
  6. 240  KEY ON:KEY 1,CC$+"view  "+CHR$(13) :KEY 2,CC$+"compute"+CHR$(13) :KEY 3,CC$+"up    "+CHR$(13) :KEY 4,CC$+"down  "+CHR$(13) :KEY 5,CC$+"left  "+CHR$(13) :KEY 6,CC$+"right "+CHR$(13) :KEY 7,CC$+"yank  "+CHR$(13)
  7. 320  KEY 8,CC$+"put   "+CHR$(13) :KEY 9,CC$+"justify"+CHR$(13) :KEY 10,CC$+"save  "+CHR$(13)
  8. 360  FOR I=0 TO LMX:A$(I)="":NEXT:CLS:ON ERROR GOTO 5000
  9. 370  PRINT"disk files:":FILES:PRINT:INPUT"disk file name (rtn=none)";F$:IF F$<>"" THEN GOSUB 1260 ELSE NLINE=0
  10. 410  INPUT"working file name (rtn=disk file name)";G$:IF G$="" THEN G$=F$
  11. 430  IF G$="" THEN END
  12. 440  IP=1:JP=0:IX=1:JY=1
  13. 460  J0=JP:J1=JP+22:GOSUB 890:LOCATE JY,1 '
  14. 470  COLOR 13,0:LINE INPUT"",X$ '
  15. 480  COLOR 10,0:JY=CSRLIN-1:XX=INSTR(X$,CC$):IF XX=0 THEN 770
  16. 510  Y$=MID$(X$,XX+1,1):IF Y$="v" THEN 460
  17. 530  IF Y$="c" THEN 9990
  18. 540  IF Y$="u" THEN IF JP>0 THEN JP=JP-1:GOTO 460 ELSE 460
  19. 550  IF Y$="d" THEN IF JP<IMX THEN JP=JP+1:GOTO 460 ELSE 460
  20. 560  IF Y$="l" THEN IF IP>HCW THEN IP=IP-HCW:GOTO 460 ELSE 460
  21. 570  IF Y$="r" THEN IF IP<178-HCW THEN IP=IP+HCW:GOTO 460 ELSE 460
  22. 580  IF Y$="y" THEN GOSUB 1382:GOTO 460
  23. 590  IF Y$="p" THEN GOSUB 1420:GOTO 460
  24. 600  IF Y$="j" THEN GOSUB 2060:GOTO 460
  25. 610  IF Y$="s" THEN GOSUB 1340:GOTO 460
  26. 620  IF Y$=CC$ THEN Y$=MID$(X$,XX+2,1) ELSE 770
  27. 640  IF Y$="v" THEN GOSUB 980:GOTO 460
  28. 650  IF Y$="c" THEN GOSUB 1190:GOTO 460
  29. 660  IF Y$="u" THEN IF JP>19 THEN JP=JP-20:GOTO 460 ELSE JP=0:GOTO 460
  30. 670  IF Y$="d" THEN IF JP<JMX THEN JP=JP+20:GOTO 460 ELSE JP=IMX:GOTO 460
  31. 680  IF Y$="l" THEN IF IP>64 THEN IP=IP-64:GOTO 460 ELSE IP=1:GOTO 460
  32. 690  IF Y$="r" THEN IF IP<113 THEN IP=IP+64:GOTO 460 ELSE IP=177:GOTO 460
  33. 700  IF Y$="y" THEN GOSUB 1382:GOSUB 1410:GOTO 460
  34. 710  IF Y$="p" THEN 1450
  35. 720  IF Y$="j" THEN GOSUB 2010:GOTO 460
  36. 730  IF Y$="s" THEN GOSUB 1570:GOTO 460
  37. 740  IF Y$="q" THEN GOTO 360
  38. 770  L$="":II=0:JX=JP+JY-1:Y$=A$(JX):LA=LEN(Y$):IF LA>IP+79 THEN II=1
  39. 790  FOR I=79 TO 1 STEP-1:X$=CHR$(SCREEN(JY,I))
  40. 810  IF II=1 THEN L$=X$+L$ ELSE IF X$<>" " THEN II=1:GOTO 810
  41. 820  NEXT:LX=IP-1:LL=LEN(L$):IF JX+1>NLINE THEN NLINE=JX+1
  42. 840  IF LX>LA THEN A$(JX)=A$(JX)+STRING$(LX-LA," ")+L$:GOTO 870
  43. 850  IF LX>LA-79 THEN A$(JX)=LEFT$(A$(JX),LX)+L$:GOTO 870
  44. 860  A$(JX)=LEFT$(A$(JX),LX)+L$+STRING$(79-LL," ")+RIGHT$(A$(JX),LA-LX-79)
  45. 870  IF JY<23 THEN 470 ELSE IF JP<IMX THEN JP=JP+1:GOTO 460 ELSE 460
  46. 890  CLS:LOCATE 24,1:COLOR 0,7:PRINT"^ ";G$;":";TAB(17);"^line";J0;"-";J1;TAB(33);"^col.";IP\LCW;"-";(IP+78)\LCW;TAB(49);"^for HELP:\[F1] ^keylist below:";:LOCATE 1,1,1,LD-1,LD
  47. 920  COLOR 6,0:FOR I=J0 TO J1:PRINT MID$(A$(I),IP,79):NEXT:RETURN
  48. 980  CLS:Q$=SPACE$(6):LOCATE 4,1:PRINT Q$;"                 ***  available functions  ***":PRINT:PRINT Q$;"[F1]  view file window           \[F1]  print help file":PRINT Q$;"     -------------spreadsheet computation key--------------"
  49. 1020  PRINT Q$;"[F2]  update computations        \[F2]  reset filenames":PRINT Q$;"     -----------------window movement keys-----------------":PRINT Q$;"[F3]  move up 1 line             \[F3]  move up 20 lines"
  50. 1050  PRINT Q$;"[F4]  move down 1 line           \[F4]  move down 20 lines":PRINT Q$;"[F5]  move left 1/2 column       \[F5]  move left 4 columns":PRINT Q$;"[F6]  move right 1/2 column      \[F6]  move right 4 columns"
  51. 1080  PRINT Q$;"     -----------------text processing keys-----------------":PRINT Q$;"[F7]  yank line into memory      \[F7]  yank and delete line":PRINT Q$;"[F8]  put yanked line in text    \[F8]  sequential line insert"
  52. 1110  PRINT Q$;"[F9]  right justify line         \[F9]  reset j-options":PRINT Q$;"     -------------------file output key--------------------":PRINT Q$;"[F10] save file to disk          \[F10] print file":PRINT
  53. 1140  PRINT Q$;"                        \\q  quit file":LOCATE 24,1:PRINT"except for F# keys, any key to continue...";
  54. 1160  Q$=INKEY$:IF Q$="" THEN 1160
  55. 1170  RETURN
  56. 1190  CLS:PRINT"working filename (rtn=";G$;:INPUT")";X$:IF X$<>"" THEN G$=X$
  57. 1210  PRINT"instruction filename (rtn=";H$;:INPUT")";X$:IF X$<>"" THEN H$=X$
  58. 1220  INPUT"switch displays (rtn=no)";I$:IF I$="" THEN RETURN
  59. 1240  IF LD=13 THEN DEF SEG=0:POKE &H410,(PEEK(&H410) AND &HCF) OR &H10:SCREEN 1,0,0,0:SCREEN 0:WIDTH 40:WIDTH 80:LOCATE,,1,6,7:LD=7 ELSE IF LD=7 THEN DEF SEG=0:POKE &H410,(PEEK(&H410) OR &H30):SCREEN 0:WIDTH 40:WIDTH 80:LOCATE,,1,12,13:LD=13
  60. 1250  RETURN
  61. 1260  '
  62. 1270  OPEN F$ FOR INPUT AS #1:FOR NLINE=0 TO LMX:LINE INPUT #1,A$(NLINE):IF EOF(1) THEN CLOSE #1:RETURN
  63. 1310  NEXT:CLOSE #1:RETURN
  64. 1340  OPEN G$ FOR OUTPUT AS #1:FOR I=0 TO NLINE:PRINT #1,A$(I):NEXT:CLOSE #1:RETURN
  65. 1382  LOCATE 24,1:INPUT;"# of lines (rtn=1) ";NM:IF NM<1 THEN NM=1
  66. 1383  IX=JP+JY-1:FOR I=0 TO NM-1:M$(I)=A$(IX+I):NEXT:RETURN
  67. 1400  IF NLINE>NM THEN NLINE=NLINE-NM ELSE NLINE=0
  68. 1410  FOR I=IX TO NLINE:A$(I)=A$(I+NM):NEXT:FOR I=NLINE+1 TO NLINE+NM+1:A$(I)="":NEXT:RETURN
  69. 1420  IX=JP+JY:FOR J=NM-1 TO 0 STEP-1:X$=M$(J):GOSUB 1520:NEXT:RETURN
  70. 1450  '
  71. 1460  CLS:J0=JP:J1=JP+JY-1:GOSUB 920:J0=J1+1:J1=JP+21:LOCATE JY+2,1:GOSUB 920:COLOR 11,0:LOCATE JY+1,1,1,LD,0 :LINE INPUT"",X$:X$=STRING$(IP-1," ")+X$:XX=INSTR(X$,CC$):IF XX<>0 THEN 460 ELSE IF CSRLIN<>JY+2 THEN BEEP:GOTO 1460
  72. 1500  IX=JP+JY:GOSUB 1520:JP=JP+1:GOTO 1460
  73. 1520  FOR I=IX TO NLINE:SWAP X$,A$(I):NEXT:NLINE=NLINE+1:IF NLINE>LMX THEN NLINE=LMX:BEEP:RETURN
  74. 1560  A$(NLINE)=X$:RETURN
  75. 1570  '
  76. 1590  CLS:GOSUB 1940:LW=80:W$="" :INPUT"top/bottom margins, in inches (rtn=0)";TBM:INPUT"linespacing (d=double; t=triple; h=1/2; s=1/3; rtn=normal)";D$:IF D$="" THEN LX=6 ELSE IF D$="d" THEN LX=3 ELSE IF D$="t" THEN LX=2
  77. 1630  IF D$="h" THEN LX=12 ELSE IF D$="s" THEN LX=18
  78. 1640  LM=TBM*LX:LPRINT CHR$(27);"A";CHR$(72/LX);CHR$(27);"2";:INPUT"characters/inch (s=16.5; m=8.25; l=5; rtn=10) ",C$:IF C$="s" OR C$="m" THEN LPRINT CHR$(15);:LW=132
  79. 1670  IF C$="l" OR C$="m" THEN W$=CHR$(14):LW=LW/2
  80. 1680  WIDTH"lpt1:",LW:INPUT"intensity (d=double, e=emphasized, b=both, rtn=light) ",I$:IF I$="d" OR I$="b" THEN LPRINT CHR$(27)+"G";
  81. 1710  IF I$="e" OR I$="b" THEN LPRINT CHR$(27)+"E";
  82. 1720  LPRINT CHR$(27);"D";:FOR I=18 TO 74 STEP 8:LPRINT CHR$(I);:NEXT:LPRINT CHR$(0);:INPUT;"from row: ",I0:INPUT;" to: ",I1:IF I1=0 THEN I1=NLINE:PRINT I1 ELSE PRINT
  83. 1770  INPUT;"from column: ",J0:INPUT;" to: ",J1:IF J1=0 THEN J1=J0+7:PRINT J1 ELSE PRINT
  84. 1790  INPUT"indentation (rtn=0 spaces) ";INDENT:IX=I0:J1=(J1-J0+1)*LCW:J0=J0*LCW+1:IF J1+INDENT>=LW THEN J1=LW-INDENT-1
  85. 1820  FOR I=1 TO LM '
  86. 1830  LPRINT:NEXT:FOR I=1 TO 11*LX-2*LM:LPRINT SPC(INDENT);W$+MID$(A$(IX),J0,J1):IF IX<I1 THEN IX=IX+1 ELSE GOSUB 1940:RETURN
  87. 1880  NEXT:FOR I=1 TO LM:LPRINT:NEXT:GOTO 1820
  88. 1940  LPRINT CHR$(27);"A";CHR$(12);'
  89. 1950  LPRINT CHR$(27);"2";:LPRINT CHR$(18);:LPRINT CHR$(20);:LPRINT CHR$(27)+"F";:LPRINT CHR$(27)+"H";:WIDTH"lpt1:",80:RETURN
  90. 2010  '
  91. 2020  LOCATE 24,1:INPUT;"line width (rtn=60)";LWIDTH:IF LWIDTH=0 THEN LWIDTH=60
  92. 2040  INPUT;"  how many lines at once (rtn=1)";JL:IF JL=0 THEN JL=1
  93. 2050  RETURN
  94. 2060  '
  95. 2070  IF LWIDTH=0 THEN GOSUB 2020
  96. 2080  J0=JY+JP-1:J1=J0+JL-1:IF J1>NLINE THEN J1=NLINE
  97. 2090  FOR IX=J0 TO J1:GOSUB 2140:NEXT:RETURN
  98. 2140  Y$=A$(IX)
  99. 2160  YL=LEN(Y$):IF RIGHT$(Y$,1)=" " THEN Y$=LEFT$(Y$,YL-1):GOTO 2160
  100. 2180  IF LEFT$(Y$,1)=CHR$(9) THEN Y$="        "+RIGHT$(Y$,YL-1):YL=YL+7
  101. 2190  IF YL=0 OR YL=LWIDTH THEN RETURN
  102. 2200  Z$="":M=1:WHILE LEFT$(Y$,1)=" ":Z$=Z$+CHR$(0):Y$=RIGHT$(Y$,YL-M):M=M+1:WEND:Y$=Z$+Y$:IF YL<LWIDTH THEN GOSUB 2420 ELSE GOSUB 2590
  103. 2260  YL=LEN(Y$):NEEDED=LWIDTH-YL:IF INSTR(Y$," ")=0 THEN NEEDED=0
  104. 2280  C$=LEFT$(A$(IX+1),1):IF C$="" OR C$=" " OR C$=CHR$(0) OR C$=CHR$(9) THEN NEEDED=0
  105. 2300  Z$="":FOR I=1 TO NEEDED
  106. 2320  M=INSTR(Y$," "):IF M=0 THEN Y$=Z$+Y$:YL=LEN(Y$):Z$="":GOTO 2320
  107. 2340  IF M=1 THEN Z$=Z$+" ":Y$=RIGHT$(Y$,YL-1):YL=YL-1:GOTO 2320
  108. 2350  Z$=Z$+LEFT$(Y$,M)+" ":Y$=RIGHT$(Y$,YL-M):YL=YL-M:NEXT:Y$=Z$+Y$:YL=LEN(Y$):Z$="":M=1:WHILE LEFT$(Y$,1)=CHR$(0):Z$=Z$+" ":Y$=RIGHT$(Y$,YL-M):M=M+1:WEND:A$(IX)=Z$+Y$:RETURN
  109. 2420  '
  110. 2430  J=IX+1:WHILE NLINE>=J:C$=LEFT$(A$(J),1):IF C$="" OR C$=" " OR C$=CHR$(9) OR C$=CHR$(0) THEN RETURN
  111. 2470  WHILE A$(J)<>"":ZL=LEN(A$(J)):M=INSTR(A$(J)," "):IF M=0 THEN ZL=ZL+1:M=ZL
  112. 2500  IF YL+M>LWIDTH THEN RETURN
  113. 2510  YL=YL+M:Y$=Y$+" ":IF M>1 THEN Y$=Y$+LEFT$(A$(J),M-1)
  114. 2520  A$(J)=RIGHT$(A$(J),ZL-M):WEND:Z$="":FOR I=NLINE TO J STEP-1:SWAP Z$,A$(I):NEXT:NLINE=NLINE-1:WEND:RETURN
  115. 2590  '
  116. 2600  Z$=RIGHT$(Y$,YL-LWIDTH):YL=LWIDTH:Y$=LEFT$(Y$,LWIDTH)
  117. 2610  C$=RIGHT$(Y$,1):YL=YL-1:Y$=LEFT$(Y$,YL):IF C$<>" " THEN Z$=C$+Z$:GOTO 2610
  118. 2630  FOR I=IX+1 TO NLINE:SWAP Z$,A$(I):NEXT:NLINE=NLINE+1:IF NLINE>LMX THEN NLINE=LMX:BEEP:RETURN
  119. 2650  A$(NLINE)=Z$:RETURN
  120. 5000  '
  121. 5010  Q$="        ...File not found...  ":IF ERR=53 AND ERL=1270 THEN PRINT Q$:RESUME 370
  122. 5030  IF ERR=53 AND ERL=9990 THEN PRINT Q$;:H$="":RESUME 9990
  123. 5040  IF ERR=61 AND ERL=1360 THEN PRINT"Disk Full:make room before saving"
  124. 5050  IF ERR=25 AND ERL=1940 THEN PRINT"Printer not On-line"
  125. 5060  IF ERR=27 THEN PRINT"Out of Paper or Printer Off"
  126. 5070  PRINT:PRINT"error #";ERR;" at line ";ERL;"; type CONT to resume...":STOP:RESUME 460
  127. 9630  IF NROW<2 THEN GOTO 9770
  128. 9640  FOR J=0 TO NCOL-1:CSUM(J)=0:FOR I=0 TO NROW-1:CSUM(J)=CSUM(J)+FNV(I+NROW0,J+NCOL0):NEXT:NEXT:I=NROW0+NROW:TSUM=0:FOR J=NCOL0 TO NCOL0+NCOL-1:X=CSUM(J-NCOL0):GOSUB 9900:TSUM=TSUM+CSUM(J-NCOL0):NEXT:J=NCOL0+NCOL:X=TSUM:GOSUB 9900
  129. 9770  IF NCOL<2 THEN RETURN
  130. 9780  FOR I=0 TO NROW-1:RSUM(I)=0:FOR J=0 TO NCOL-1:RSUM(I)=RSUM(I)+FNV(I+NROW0,J+NCOL0):NEXT:NEXT:J=NCOL0+NCOL:FOR I=NROW0 TO NROW0+NROW-1:X=RSUM(I-NROW0):GOSUB 9900:NEXT:RETURN
  131. 9900  X$=STR$(X)
  132. 9920  LX=LEN(X$):IF LX<LCM THEN X$=STRING$(LCM-LX," ")+X$ ELSE X$=LEFT$(X$,LCM)
  133. 9940  LA=LEN(A$(I)):LX=LCW*J:IF LX>LA THEN A$(I)=A$(I)+STRING$(LX-LA," ")+X$:RETURN
  134. 9960  IF LX>LA-LCM THEN A$(I)=LEFT$(A$(I),LX)+X$:RETURN
  135. 9970  A$(I)=LEFT$(A$(I),LX)+X$+RIGHT$(A$(I),LA-LX-LCM):RETURN
  136. 9990  IF H$="" THEN LOCATE 24,1:INPUT;"instruction filename";H$:IF H$="" THEN 460 ELSE CHAIN MERGE H$,10000,ALL
  137. 10000  '
  138. 10010  ON ERROR GOTO 5000 :NROW0=FNV(2,6):NCOL0=FNV(3,6):NROW=FNV(4,6):NCOL=FNV(5,6) :GOSUB 9630 :I=NROW0+NROW:J=NCOL0-1:X$="Column Totals":GOSUB 9920 :I=NROW0-2:J=NCOL0+NCOL:X$="Row Totals":GOSUB 9920 :GOTO 460
  139.